home *** CD-ROM | disk | FTP | other *** search
/ MacHack 1994 / MacHack 1994.toast / MacHack™94 / Talks & Papers / Timothy Knox / yerk 3.66 / tool+ / savedlg < prev    next >
Text File  |  1994-06-24  |  4KB  |  132 lines
  1. \ Dialog subclass that saves an ascii representation of its data. Data may
  2. \ be changed
  3. \ 11.26.90    rfl    added clear: parms to release:  An error may occur if the
  4. \                image is saved with parms. But fixed with new: sarray clearing size.
  5. \ 11.28.90    rfl    added dialog1 class to allow enabling etc. with controls
  6. \ 12.13.91    rfl    SP added alive: and close: to dialog1
  7. \ 3.3.92    rfl    changed string 161 to 186 for not finding STRG resource
  8. \ 5.13/93    rfl    no longer detach resource in grab; also, getnew: savedlg reads
  9. \                  in sarraystrg..don't have to grab at beginning of program
  10. \ 3.15.94    rfl    added clear: size for release:
  11.  
  12.  
  13. :CLASS dialog1 <super dialog
  14.  
  15.   :M close: close: super clear: dialPtr ;M
  16.   :M alive: ( -- b) get: dialPtr 0 <> ;M
  17.   :M hiliteCtl: ( n item --) handle: self swap makeint call hiliteControl ;M
  18.   :M drawItem: ( item --) dup getText: self rot putText: self ;M
  19.   :M dim: { n item -- } item handle: self drop
  20.         get: itemType 4 and                            \ is it a control?
  21.         IF  n item hiliteCtl: self THEN                \ standard disable
  22.         get: itemType 16 and
  23.         IF -3 -3 inset: temprect THEN                \ is it editable text?
  24.         n 0<
  25.         IF 3 -> n                                    \ also grey out item rectangle
  26.             set: self w 11 call penMode n syspat +base call penpat
  27.              paint: temprect call penNormal
  28.         ELSE item drawItem: self                    \ redraw original item
  29.         THEN ;M
  30.  
  31.   :M enable: ( item --)   0 swap dim: self ;M
  32.   :M disable: ( item --) -1 swap dim: self ;M
  33.  
  34.   :M hideItem: ( item --) get: dialPtr swap makeint call hideDItem ;M
  35.   :M showItem: ( item --) get: dialPtr swap makeInt call showDItem ;M
  36.  
  37. ;CLASS
  38.  
  39. \ uses Pstring format (text with byte at front showing length of text)
  40. \  same as sarray, but can be read from resource.
  41. :CLASS sarrayStrg <super sarray
  42.  
  43.     int    resID
  44.     int    keepAsRsrc        \ true if want to save the info in rsrc file
  45.  
  46.   :M putResID: put: resID ;M
  47.  
  48.   :M SaveAsRsrc: true put: keepAsRsrc ;M
  49.   :M dontSaveAsRsrc: clear: keepAsRsrc ;M
  50.  
  51.   :M getnew: ( --)
  52.     get: resID 'type STG# (getres) m! m@ 0=
  53.     IF   new: self
  54.     ELSE get: self scount put: size
  55.     THEN ;M
  56.  
  57.   :M save: get: keepAsRsrc IF m@ call changedResource m@ call writeResource THEN ;M
  58.  
  59.   :M release: m@ call releaseResource 0 m! clear: size ;M
  60.  
  61. ;CLASS
  62.  
  63. :CLASS SaveDlg <super dialog1
  64.  
  65.     sarrayStrg    parms
  66.  
  67.   :M putResID: dup putResID: super putResID: parms ;M
  68.  
  69. \ doesn't save useritems, since methods are unknown...just adds place holder
  70.   :M save: clear: parms 0 0 add: parms limit 1
  71.         DO i handle: self drop get: itemType dup 4 and    \ 4=ctrlItem
  72.             IF   i get: self bin>asc add: parms drop
  73.             ELSE  $ 18 and                                \ $10 or $8=text item
  74.                  IF   i getText: self add: parms
  75.                  ELSE 0 0 add: parms                    \ any other item type, fake
  76.                  THEN
  77.             THEN
  78.         LOOP
  79.         save: parms ;M
  80.  
  81. \ doesn't handle a user item, since method of fill unknown
  82.    :M fill: limit: parms -dup
  83.         IF limit: self <> classErr" 186
  84.             limit 1
  85.             DO  i handle: self drop get: itemType dup 4 and
  86.                 IF   i at: parms asc>bin i put: self drop
  87.                 ELSE $ 18 and
  88.                     IF i  at: parms i putText: self THEN
  89.                 THEN
  90.             LOOP
  91.         THEN ;M
  92.  
  93.   :M getNew: getNew: super valid: parms not IF getNew: parms THEN fill: self ;M
  94.  
  95.   :M new: new: parms ;M
  96. \ grab a STG# resource and fill parms with it. Use in place of new.
  97. \ parms id is same as dialog
  98.   :M grab: ( --) get: resID putResID: parms getnew: parms ;M
  99.  
  100.   :M getParms: get: parms ;M
  101.   :M fillParms: ( anotherParm --) put: parms ;M
  102. \ fill an empty sarray (not new:) with IVARS of pars
  103.   :M =: { mySarray -- } addr: parms mySarray length: mySarray cmove ;M
  104.   :M atParm: ( ind -- addr len) at: parms ;M
  105.   :M toParm: ( addr len ind --) to: parms ;M
  106.   :M print: print: parms ;M
  107.  
  108.   :M closeSave: save: self close: self ;M
  109.  
  110.   :M release: release: parms clear: parms ;M
  111.  
  112.   :M lock: lock: parms ;M
  113.   :M unlock: unlock: parms ;M
  114.  
  115.   :M saveAsRsrc: saveAsRsrc: parms ;M
  116.   :M dontSaveAsRsrc: dontSaveAsRsrc: parms ;M
  117.  
  118. \ for saving and restoring parameters to disk
  119.   :M write: size: parms sp@ 4 write: topfile 2drop
  120.         lock: parms get: parms write: topfile drop unlock: parms ;M
  121.  
  122.   :M read: buf255 4 read: topfile drop
  123.         buf255 @ setsize: parmstr topfile size: parmstr read: parmstr drop
  124.         lock: parmstr get: parmstr put: parms unlock: parmstr ;M
  125.  
  126. ;CLASS
  127.  
  128. : getter save: caller closer ;
  129.  
  130. \ ascii string true...use with atParm: which returns a " 1" or " 0"
  131. : s1= " 1" s= ;
  132.